home *** CD-ROM | disk | FTP | other *** search
/ Especial Multimedia / Especial Multimedia.iso / Multimed / Prg / WAVSHOW.ZIP / WAVESHOW.PAS < prev    next >
Pascal/Delphi Source File  |  1997-09-14  |  4KB  |  139 lines
  1. unit Waveshow;
  2. { ------------------------------------------------------------------}
  3. { WavShow - A Simple 8-bit .WAV file displayer in Borland's Delphi. }
  4. { Written by Pete Cervasio on April 8, 1995.                        }
  5. { Released to the public domain.                                    }
  6. { ------------------------------------------------------------------}
  7.  
  8. interface
  9.  
  10. uses
  11.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  12.   Forms, Dialogs, ExtCtrls, StdCtrls;
  13.  
  14. type
  15.   TForm1 = class(TForm)
  16.     ScrollBar1: TScrollBar;
  17.     OpenDialog1: TOpenDialog;
  18.     cmdOpen: TButton;
  19.     cmdExit: TButton;
  20.     Panel1: TPanel;
  21.     PaintBox1: TPaintBox;
  22.     procedure cmdOpenClick(Sender: TObject);
  23.     procedure FormCreate(Sender: TObject);
  24.     procedure cmdExitClick(Sender: TObject);
  25.     procedure PaintBox1Paint(Sender: TObject);
  26.     procedure ScrollBar1Change(Sender: TObject);
  27.     procedure FormDestroy(Sender: TObject);
  28.   private
  29.     { Private declarations }
  30.     FileIsOpen : Boolean;
  31.     TheFileName : String[79];
  32.     WaveFile : File;
  33.     WaveBytes : LongInt;
  34.     CurrPos : LongInt;
  35.     BytesPerSBPosition : Integer;
  36.   public
  37.     { Public declarations }
  38.   end;
  39.  
  40. var
  41.   Form1: TForm1;
  42.  
  43. implementation
  44.  
  45. {$R *.DFM}
  46.  
  47. { We're spoofing here.  The header is *usually* 44 bytes long.  It }
  48. { would be better to just read the doggone thing and make sure. }
  49. const
  50.     WaveHdrSize = 44;
  51.  
  52. { if you make the PaintBox wider than 1024, you will really need to }
  53. { make this larger!  It will be GPF city if you don't. }
  54. var
  55.     ReadBuffer : Array[0..1023] of Byte;
  56.  
  57. procedure TForm1.FormCreate(Sender: TObject);
  58. begin
  59.     FileIsOpen := False;
  60.     OpenDialog1.DefaultExt := 'wav';
  61.     OpenDialog1.FileName := '*.wav';
  62.     OpenDialog1.Filter := 'Wave files (*.wav)|*.wav';
  63.     Form1.Caption := 'Pete C.''s Wave Displayer';
  64. end;
  65.  
  66. procedure TForm1.cmdOpenClick(Sender: TObject);
  67. begin
  68.     if OpenDialog1.Execute then
  69.     begin
  70.         if FileIsOpen then CloseFile (WaveFile);
  71.         try
  72.             TheFileName := OpenDialog1.Filename;
  73.             AssignFile (WaveFile, TheFileName);
  74.             Reset (WaveFile, 1);
  75.             FileIsOpen := True;
  76.             Form1.Caption := TheFileName;
  77.             WaveBytes := FileSize (WaveFile) - WaveHdrSize;
  78.             BytesPerSBPosition := 1;
  79.             while (WaveBytes div BytesPerSBPosition) > 32767 do
  80.                 inc(BytesPerSBPosition);
  81.             if WaveBytes div BytesPerSBPosition > PaintBox1.Width then
  82.             begin
  83.                 ScrollBar1.Visible := True;
  84.                 ScrollBar1.Max := WaveBytes div BytesPerSBPosition
  85.                                 - PaintBox1.Width;
  86.             end
  87.             else
  88.                 ScrollBar1.Visible := False;
  89.             if ScrollBar1.Position <> 0 then
  90.                 ScrollBar1.Position := 0
  91.             else
  92.                 PaintBox1.Refresh;
  93.         except
  94.             on E: EInOutError do
  95.                 MessageDlg ('Unable to open ' + TheFileName + #10 + #13
  96.                             + 'Error was ' + E.Message, mtError, [mbOK], 0);
  97.         end;
  98.     end;
  99. end;
  100.  
  101. procedure TForm1.PaintBox1Paint(Sender: TObject);
  102. var
  103.     X, NumRead : Integer;
  104.     CurrPos : LongInt;
  105. begin
  106.     if FileIsOpen then
  107.     begin
  108.         CurrPos := (ScrollBar1.Position * BytesPerSBPosition) + WaveHdrSize;
  109.         Seek (WaveFile, CurrPos);
  110.         with PaintBox1.Canvas do
  111.         begin
  112.             FillChar (ReadBuffer, SizeOf(ReadBuffer), $80);
  113.             BlockRead (WaveFile, ReadBuffer, ClipRect.Right, NumRead);
  114.             Pen.Color := clLime;
  115.             MoveTo (0, ReadBuffer[0] shr 1);  { 128 bit high picture }
  116.             for X := 1 to NumRead - 1 do
  117.                 LineTo (X, ReadBuffer[X] shr 1);
  118.         end;
  119.     end;
  120. end;
  121.  
  122. procedure TForm1.ScrollBar1Change(Sender: TObject);
  123. begin
  124.     PaintBox1.Refresh;
  125. end;
  126.  
  127. procedure TForm1.cmdExitClick(Sender: TObject);
  128. begin
  129.     Application.Terminate;
  130. end;
  131.  
  132. procedure TForm1.FormDestroy(Sender: TObject);
  133. begin
  134.     if FileIsOpen then CloseFile (WaveFile);
  135. end;
  136.  
  137. end.
  138.  
  139.